COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C00015 ENDMK
C⊗;
C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.


C  7/74 **********  SCORE  **********  LELAND SMITH, SEP.1969

C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
C   GENERATION PROGRAM.
C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C   LOAD 'S1' WITH S2,S3,SCANR AND SPRINT 
C   (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C	SUBROUTINE SUBR
C	COMMON /P/P(1) /PL/PL(1) /INS/ INST(27),BG(60)
C	COMMON INUM,IPAR,CNT(27),BT,IREST,DF,DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-108)  C4=49  FS4=55  B4=60  C5=61  ETC.
C   F0=200  F99=299 (LIMIT IS F0-F99!)  'R'(REST)=199

C11	DOUBLE PRECISION KNM,IFLNM
	COMMON /Q/ BNW(200),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,JED /SAM/ISAM,ITRUNC
C  SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
	COMMON/VV/LIMIT,V(2000) /A/ROFF(27),NP(27),
	1 RDEV(27),XT(27),OTH(20,16),P1(27),JFM(4),IFM(80)
	1 ,INVIS(27)
	DIMENSION LIST(78),JNP(80)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 99 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.

	COMMON /PCIP/ PCH(27,102),IPT(27,101) /ALPH/IALPH(14)
	COMMON/P/P(99) /PL/PL(117) /COPY/NUMP,COPY(99) /COPYL/COPYL(99)
C NUMP=99 = TOTAL NUMBER OF PARAMETERS NOW AVAILABLE. RAN.DEV. IS NUMP+1
	COMMON J,L,CNT(27),BT,MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (LIST,IFM(3)),(JN,JNP,INP),(IEE,ISCA(5)),(IDD,ISCA(3))
	1,(ITT,ISCA(11)),(III,IALPH(2)),(IYY,IALPH(14)),(JN2,JNP(2)),
	1(JN3,JNP(3)),(JN4,JNP(4)),(INN,IALPH(7)),(IOO,ISCA(4)),(IFF,
	1 ISCA(6)),(IHH,IALPH(1)),(ILL,IALPH(5)),(IPP,ISCA(2))
	DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/5000/,NUMP/99/
	1, JFM(3)/','/
C  IAA=A  IDD=D  IEE=E  IF=F  INN=N  IPP=P  ISS=S  ITT=T
	DATA IBLA/' '/,IXX/'X'/,ITYPE/'TYPE'/,ITYPD/'TYPD'/,
	1 IHELP/'HELP'/,IQUES/'?'/,INFO/'INFO'/,IEDIT/'EDIT'/
	1 ,ISCA/'C','P','D','O','E','F','Z','G','S','A','T','B'/
	1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
	1,IALPH/'H','I','J','K','L','M','N','Q','R','U','V','W','X'
	1,'Y'/
	TYPE 8003
8003	FORMAT(' FOR "MUS10" OUTPUT, FIRST TYPE "MUS10"'/)
C	1' NOW 99 PARAMETERS MAY BE USED.'/
C	1'     FOR RANDOM RESTS USE RR '/
C	1'         FOR RANDOM P1 DEVIATION USE RD'/)
	ISAM=-1
	ITRUNC=0
	LPAR=0
	IPRN=0
	QX=0.
	MOT=0
	RETRO=-1.
	INVRT=-1
	ICON=-1
	LCNT=1
	PARENS=0
      JZ=1  
CKL	CALL RNDINT
C  INIT RAND NUM GENERATOR.
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      T5=0  
      NINS=0
	K=0
	IDALL=-1
	QTS=-1.
      KB=0  
      NWZ=1
	BNW(1)=0
	I=1
      KL=0  
      RA=0  
      CHN=0 
	DO 127 K=1,77,3
127	LIST(K)=0
C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
	NWX=0
	BY=-1
      DO 1128 K=1,KZY     
	INVIS(K)=0
	INST(K)=0
	CNT(K)=0
	RDEV(K)=0
C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
	NP(K)=0
	IQ(K)=0
C   IQ IS FOR RESTART FLAG
	IPT(K,1)=0
      DO 1128 L=1,NUMP+2
1128   PCH(K,L)=0 

	ITYP=-1
C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
	JED=-1
2112	TYPE 8002
1112	ACCEPT 77732,JNP
	IF(JN.NE.IEE)GO TO 3112
	IF(JN2.NE.IDD)GO TO 3112
	IF(JN3.NE.III)GO TO 3112
	IF(JN4.NE.ITT)GO TO 3112
C NOW FOUND 'EDIT'
CKL	JFM(4)='5F)'
CKL	JFM(1)='   (A'
C   FOR FREE 'A' FORMAT
CKL	CALL FMT(JFM,JNP,MLX)
CKL	REREAD JFM,K,TF,AMPFAC,OP1,DURX
C  JFM IS THE CURRENT FORMAT STATEMENT
C SAMSWITCH ALLOWS FOR OVERLAPS OF INSTRUMENTS AND OMITS 'PLAY' AT TOP.
CKL999	IF(K.NE.IEDIT)GO TO 3112
	JED=0
	GO TO 2112
C  'E(DIT)' GOES TO EDIT MODE
CKL3112 	IF(K.NE.ITYPE)GO TO 128
3112	IF(JN.NE.ITT)GO TO 128
	IF(JN2.NE.IYY)GO TO 128
	IF(JN3.NE.IPP)GO TO 128
	IF(JN4.NE.IEE)GO TO 128
C FOUND 'TYPE'
	ITYP=0
	IFLNM=ITYPD
	CALL OFILE(21,IFLNM)
	GO TO 3127
8001	FORMAT(A5,5F)
77732	FORMAT(80A1)
300	FORMAT(I,3F)
128	IF(JN.NE.IHH)GO TO 1280
	IF(JN2.NE.IEE)GO TO 1280
	IF(JN3.NE.ILL)GO TO 1280
	IF(JN4.NE.IPP)GO TO 1280
C FOUND 'HELP'
CKL128	IF(K.EQ.INFO)GO TO 1280
CKL	IF(K.EQ.IHELP)GO TO 1280
CKL	IF(K.NE.IQUES)GO TO 3128
1280	TYPE 8002
	TYPE 1113
	TYPE 118
	TYPE 1114
	TYPE 8002
	GO TO 1112
118	FORMAT(' TO DSK=1,11   TTY=2,22   BOTH=0,33   LPT=4'/)
C118	FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
CC***  TEMPORARY ***8002	FORMAT(' TYPE FILE NAME'/)
8002	FORMAT(' TYPE FILE NAME--  '$)
1113	FORMAT(' YOU MAY TYPE:  NAME  TEMPO-FAC  AMPFAC  OMIT"  DUR"'//)
1114	FORMAT('    FOR THE ABOVE YOU MAY TYPE UP TO 3 NUMBERS: N1 N2 N3'//
	1' N1 = 1 WRITES DATA ON DSK,  =2 WRITES ONLY ON SCREEN,'/
	1'    = 0 WRITES ON DSK AND SCREEN.'/
	1'    = 11,22,33 ARE THE SAME AS 1,2,0 BUT INPUT LIST IS NOT
	1 WRITTEN ON SCREEN.'/
	1/' N2 = RAN NUM INITIALIZATION.       N3 = DO ONLY INST. #N'/
	1/' ALSO FOR N1:  N1=5(OR 55)=DURS ONLY (FOR PROOFING)
	1, =6(OR 66)=DEBUG V ARRAY'//
	1 3X' UP TO 99 PARAMETERS AND 27 INSTRUMENTS ARE AVAILABLE'/)

3128	DO 2203 K=80,1,-1
2203	IF(JNP(K).NE.IBLA)GO TO 2204
	AMPFAC=1.
	TF=1.
	OP1=0
	DURX=0
	KNM=IFLNM
	GO TO 3127
2204	LEND=K+1
	JNP(LEND)=ISEMI
	DO 2201 ML=1,5
2201	IF(JNP(ML).EQ.IBLA)GO TO 2202
2202	CALL PACKIT(L,KNM,JNP)
C PACKS SINGLE CHARS INTO ONE DBL. PREC. WORD(K).
	IF(ML.LT.LEND)CALL SCANR
	TF=VX(1)
	AMPFAC=VX(2)
	OP1=VX(3)
	DURX=VX(4)
	IF(TF.EQ.0)TF=1.
	IF(AMPFAC.EQ.0)AMPFAC=1.
	CALL IFILE(23,KNM)
	IFLNM=KNM
CKL	READ(23,300)LN,IXIN
C  CHECK FOR LINE NUMBERS ONLY.
CKL	REREAD 8001,K
CKL	IF(K.NE.'COMME')GO TO 3000
3001	READ(23,77732)JNP
CKL	IF(JNP(3).NE.ISEMI)GO TO 3001
CKL	GO TO 3127
C  TO READ HEADER OF 'ET' FILES
CKL3000	REWIND 23
CKL	CALL IFILE(23,IFLNM)

CC3127	ISLAC=(IFLNM.AND."003777777777).OR."550000000000
C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
3127	ISLAC=IFLNM
C  NOW USES MY FORNAM SUBROUTINE TO  PUT EXTENSION .SCR ON OUTPUT
5127	TYPE 118
	IF(DURX.EQ.0)DURX=19999.
	IXIN=1
	INONLY=-1
	SOS=-1.
	ACCEPT 300,MX,X,Z
	IF(MX.NE.99)GO TO 6127
2200	FORMAT(' TYPE OUTPUT FILE NAME'/)
	TYPE 2200
	ACCEPT 8001,ISLAC
	GO TO 5127
6127	IF(Z.NE.0)INONLY=Z
	IF(X.NE.0)IXIN=X
	IF(MX.LT.10)GO TO 8127
	MX=MX/10
	IF(MX.EQ.3)MX=0
	SOS=0
C MX=10,11,ETC.,22,ETC.(INSTEAD OF 1,2) SUPPRESSES INPUT LISTING.
8127	JOUT=5
C  5=OUTPUT TO TTY
CC	JOUT=3 DIRECT TO LPT AT COLGATE 6/74
	MZ=0
	GO TO(110,210,310,410,510,610)MX
C 0=DSK,TTY  1=DSK  2=TTY  3=0  4=LPT  5=TTY  6=TTY
310	MZ=-1
110	CALL FORNAM(ISLAC,'SCR')
	MX=-1  
	CALL READIT
410	JOUT=22
210	MZ=-1
510	CALL READIT
610	MZ=-6
	CALL READIT
      END

	SUBROUTINE RUNIT
	COMMON /Q/ BNW(200),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,JED /SAM/ISAM,ITRUNC
C  SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
	COMMON/VV/LIMIT,V(2000) /A/ROFF(27),NP(27),
	1 RDEV(27),XT(27),OTH(20,16),P1(27),JFM(4),IFM(80)
	1 ,INVIS(27)
	COMMON /PCIP/ PCH(27,102),IPT(27,101)
	COMMON/P/P(99) /PL/PL(117) /COPY/NUMP,COPY(99) /COPYL/COPYL(99)
C NUMP=99 = TOTAL NUMBER OF PARAMETERS NOW AVAILABLE. RAN.DEV. IS NUMP+1
	COMMON J,L,CNT(27),BT,MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	DATA NAME/'SC'/

 
	CALL OFILE(1,NAME)
	WRITE(1)I,NWZ
	END

	SUBROUTINE PACKIT(L,KNM,JNP)
	DIMENSION JNP(1)
C THIS ROUTINE WILL PACK 1 TO 4 SINGLE CHARS FROM JNP ARRAY INTO
C DOUBLE PRECISION WORD, KNM.  L IS CHAR COUNT.
	REREAD 1,KNM
1	FORMAT(A4)
	END